home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1986 July / 64er_Magazin_86-07_1986_Markt__Technik_de.d64 / big change (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  2KB  |  101 lines
  1. 10 rem *** zeichensatzaenderung ***
  2. 20 rem *** fuer "the newsroom"  ***
  3. 30 rem ***    grosse schrift    ***
  4. 50 dimb(3500)
  5. 60 poke53280,3:poke53281,3
  6. 70 print"[147]"
  7. 90 input"[147]zeichensatz (0-2):";s$
  8. 100 f$="lfnt"+s$+",p,r"
  9. 110 open 3,8,3,f$
  10. 115 print"bitte geduld - ist halt nur basic"
  11. 120 an=an+1:gosub 1000:b(an)=a
  12. 130 if st=0 then120
  13. 140 close 3
  14. 200 for l=4to132
  15. 210 ifb(l)=0then 310
  16. 220 gosub5000:print""
  17. 230 v=0:w=0:gosub2000
  18. 240 v=8:w=1:gosub2000
  19. 250 v=320:w=16:gosub2000
  20. 260 v=328:w=17:gosub2000
  21. 305 print"zeichen #:"l
  22. 310 print"breite   :"b(l)
  23. 315 x=0:y=0:poke1076,peek(1076)or128
  24. 320 geta$:ifa$=""then320
  25. 325 ifa$="*"theninput"zeichen #:";l:goto210
  26. 326 ifa$="@"theninput"neue zeichen #:";l:gosub1700:goto410
  27. 330 if a$="^"thenl=132:goto410
  28. 340 if a$=""thengosub1100
  29. 350 if a$="[157]"thengosub1200
  30. 360 if a$=""thengosub1300
  31. 370 if a$="[145]"thengosub1400
  32. 380 ifa$="="thengosub1600
  33. 390 ifa$=chr$(13)thengosub1700:goto410
  34. 395 ifa$=" "then 410
  35. 400 goto 320
  36. 410 nextl
  37. 415 f$="@:newfont"+s$+",p,w"
  38. 420 open3,8,3,f$
  39. 430 forl=1toan
  40. 440 print#3,chr$(b(l));
  41. 450 next
  42. 460 close3
  43. 470 end
  44. 1000 get#3,a$
  45. 1010 ifa$=""thena=0:return
  46. 1020 a=asc(a$):return
  47. 1100 rem *** cursor rechts ***
  48. 1110 gosub 1500
  49. 1120 if x<15then x=x+1
  50. 1130 gosub 1500
  51. 1140 return
  52. 1200 rem *** cursor links ***
  53. 1210 gosub 1500
  54. 1220 if x>0then x=x-1
  55. 1230 gosub 1500
  56. 1240 return
  57. 1300 rem *** cursor runter ***
  58. 1310 gosub 1500
  59. 1320 if y<15then y=y+1
  60. 1330 gosub 1500
  61. 1340 return
  62. 1400 rem *** cursor rauf ***
  63. 1410 gosub 1500
  64. 1420 if y>0then y=y-1
  65. 1430 gosub 1500
  66. 1440 return
  67. 1500 rem *** cursor setzen/loeschen ***
  68. 1510 ifpeek(1076+x+y*40)>128thenpoke1076+x+y*40,peek(1076+x+y*40)and127:return
  69. 1520 poke1076+x+y*40,peek(1076+x+y*40)or128:return
  70. 1600 rem *** punkt setzen/loeschen ***
  71. 1610 if peek(1076+x+y*40)=160thenpoke1076+x+y*40,209:return
  72. 1620 if peek(1076+x+y*40)=209thenpoke1076+x+y*40,160:return
  73. 1700 rem *** neues zeichen ***
  74. 1710 gosub1500:input"breite   ";b(l)
  75. 1720 v=0:w=0:gosub3000
  76. 1730 v=8:w=1:gosub3000
  77. 1740 v=320:w=16:gosub3000
  78. 1750 v=328:w=17:gosub3000
  79. 1760 return
  80. 2000 rem *** teilzeichen setzen ***
  81. 2010 fork=0to7
  82. 2020 form=0to7
  83. 2030 if(b(l*32+3+k*2+w)and2^m)=0then2050
  84. 2040 poke1076+k*40+(7-m)+v,81
  85. 2050 poke55348+k*40+(7-m)+v,6
  86. 2060 nextm,k
  87. 2070 return
  88. 3000 rem *** teilzeichen holen ***
  89. 3010 fork=0to7:b(l*32+3+k*2+w)=0
  90. 3020 form=0to7
  91. 3030 ifpeek(1076+k*40+(7-m)+v)=81thenb(l*32+3+k*2+w)=b(l*32+3+k*2+w)or2^m
  92. 3040 nextm,k
  93. 3050 return
  94. 5000 rem *** bildschirmaufbau ***
  95. 5010 print"[147]                             "
  96. 5020 fork=1to16
  97. 5030 print"             "
  98. 5040 next
  99. 5050 print"                             "
  100. 5060 return
  101.